
open Chipmunk.Low_level

(* the Segment object *)
module Segment = struct
	type t = cpShape * cpSegmentShape

	let create space startX startY endX endY =
		(* we define the segment object to be static,
		 * so the body will have infinite mass and momentum *)
		let body = cpBodyNew infinity infinity in
		(* and the shape is just a segment *)
		let shape = cpSegmentShapeNew ~body ~a:(cpv startX startY) ~b:(cpv endX endY) ~r:0.0 in
		let () = cpShapeSetElasticity ~shape ~e:1.0 in	
		let () = cpShapeSetFriction ~shape ~u:1.0 in
		(* register shape for collisions in space *)
		let () = cpSpaceAddStaticShape ~space ~shape in
		(* there could be cpShapeSetCollisionType here,
		 * but it is not needed now, defaults to 0 *)
		(shape, cpSegmentShape_of_cpShape shape)

	(* convert shape for drawable representation as Types.Data.t *)
	let show (shape, segment) = 
		let body = cpShapeGetBody ~shape in
		let relative1 = cpSegmentShapeGetA segment in
		let relative2 = cpSegmentShapeGetB segment in
		let absolute1 = cpvadd (cpBodyGetPos ~body)
			(cpvrotate (relative1) (cpBodyGetRot ~body)) in
		let absolute2 = cpvadd (cpBodyGetPos ~body)
			(cpvrotate (relative2) (cpBodyGetRot ~body)) in
		Types.Data.List [
			Types.Data.String "Segment";
			Types.Data.Float absolute1.cp_x;
			Types.Data.Float absolute1.cp_y;
			Types.Data.Float absolute2.cp_x;
			Types.Data.Float absolute2.cp_y]
	
	(* draw segment from the representation created above *)	
	let draw data = match data with
		| Types.Data.List [
			Types.Data.String "Segment";
			Types.Data.Float aX;
			Types.Data.Float aY;
			Types.Data.Float bX;
			Types.Data.Float bY] ->
				(* draw separate lines *)
				let () = GL.glBegin GL.GL_LINES in
					(* set color to white *)
					let () = GL.glColor3 1.0 1.0 1.0 in
					let () = GL.glVertex2 aX aY in
					let () = GL.glVertex2 bX bY in
				let () = GL.glEnd() in
				()
		| _ -> assert false
	
	(* segment doesn't do anything *)	 	
	let step shape = ()
end

module Box = struct
	type t = cpBody * float (* body, size *)

	let genVerts centerX centerY size rot = 
		Array.map 
			(fun v -> cpvadd (cpv centerX centerY) (cpvrotate v rot))
			[|cpv ~x:size ~y:size; 
			  cpv ~x:(size) ~y:(-.size);
			  cpv ~x:(-.size) ~y:(-.size); 
			  cpv ~x:(-.size) ~y:(size) |]
				
	let create space centerX centerY size mass =
        let size' = size *. Config.cellSize *. 0.5 in
		let verts = genVerts 0.0 0.0 size' (cpv ~x:1.0 ~y:0.0) in
		(* calculate the momentum for the given polygon from mass *)
		let moment = cpMomentForPoly mass verts (cpvzero()) in
		(* create body with appriopriate mass and momentum *)
		let body = cpBodyNew mass moment in
		(* starting position *)
		let () = cpBodySetPos body (cpv centerX centerY) in
		let () = cpSpaceAddBody space body in
		(* shape for collision detection, must be convex *)
		let shape = cpPolyShapeNew body verts (cpvzero()) in
		let () = cpShapeSetElasticity shape 0.0 in
		let () = cpShapeSetFriction shape 1.5 in
		(* explicite set collision type (the default is 0 too) *)
		let () = cpShapeSetCollisionType shape 0 in
		(* register the shape in space *)
		let () = cpSpaceAddShape space shape in
		(* our object representation *)
		(body, size)
	
	let show (body, size) = 
		let rot = cpBodyGetRot ~body in
		Types.Data.List[
			Types.Data.String "Box";
			Types.Data.Float (cpBodyGetPos ~body).cp_x;
			Types.Data.Float (cpBodyGetPos ~body).cp_y;
			Types.Data.Float size;
			Types.Data.Float rot.cp_x;
			Types.Data.Float rot.cp_y]

	let draw data = match data with
		| Types.Data.List [
			Types.Data.String "Box";
			Types.Data.Float cX;
			Types.Data.Float cY;
			Types.Data.Float size;
			Types.Data.Float rotX;
			Types.Data.Float rotY] ->
				let size = size *. Config.cellSize *. 0.5 in
				let verts = genVerts cX cY size (cpv ~x:rotX ~y:rotY) in
				let () = GL.glBegin GL.GL_LINE_LOOP in
				let () = GL.glColor3 1.0 1.0 1.0 in
				let () = 
					for ii = 0 to pred 4 do
						GL.glVertex2 verts.(ii).cp_x verts.(ii).cp_y
					done 
				in GL.glEnd()
		| _ -> assert false

	let step (body, size) = ()
end

type t = Segment of Segment.t
	   | Box of Box.t

let show obj = match obj with
	| Segment segment -> Segment.show segment
	| Box box -> Box.show box

let draw data = match data with
	| Types.Data.List (Types.Data.String "Segment" :: _) -> 
		Segment.draw data
	| Types.Data.List (Types.Data.String "Box" :: _) -> 
		Box.draw data
	| data -> failwith ("Don't know how to draw: " ^ Types.Data.show data)

let step obj = match obj with
	| Segment segment -> Segment.step segment
	| Box box -> Box.step box

